home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / netsystem.mod (.txt) < prev    next >
Oberon Text  |  1996-07-28  |  13KB  |  420 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE NetSystem;
  4. (*BD, 13.2.96 *)
  5.     IMPORT SYSTEM, Texts, Oberon, Input, B := AmigaNetBase;(* insert here the name of your specific module NetBase *)
  6.     CONST
  7.         (* res values *)
  8.         done* = 0;    (*everything went ok*)
  9.         error* = 1;    (*failure occured*)
  10.         timeout* = 2;    (*opening a connection is timed out*)
  11.         (* return values of procedure State *)
  12.         closed* = 0;    (*connection is closed (neither sending nor receiving)*)
  13.         listening* = 1;    (*passive connection is listening for a request*)
  14.         in* = 2;    (*receiving only*)
  15.         out* = 3;    (*sending only*)
  16.         inout* = 4;    (*sending and receiving is possible*)
  17.         (* any port value *)
  18.         anyport* = 0;
  19.         anyaddr = 0;
  20.         buffersize = 1024;
  21.     TYPE
  22. IPAdr* = B.IPAdr;    (* Internet Address, where IPAdr[0] contains the most significant byte *)
  23.         Connection* = POINTER TO ConnectionDesc;    (* TCP-Connection *)
  24.         ConnectionDesc* = RECORD
  25.             socket: LONGINT;
  26.             state: INTEGER;
  27.             res*: INTEGER;    (*result of LRU operation on a connection (error indication)*)
  28.             recvbuffer: ARRAY buffersize OF SYSTEM.BYTE;
  29.             nofelems, begidx, endidx: LONGINT;
  30.         END;
  31.         Socket*= POINTER TO SocketDesc;    (* UDP-Connection *)
  32.         SocketDesc* = RECORD
  33.             socket: LONGINT;
  34.             res*: INTEGER;    (*result of LRU operation on a socket (error indication)*)
  35.         END;
  36.         hostname*, gateway*: ARRAY 65 OF CHAR;
  37.         user*, passwd*: ARRAY 17 OF CHAR;
  38.         hostIP*, anyIP*, allIP*: IPAdr;
  39.     PROCEDURE Minimum(a, b: LONGINT): LONGINT;
  40.     BEGIN
  41.         IF a <= b THEN RETURN a ELSE RETURN b END
  42.     END Minimum;
  43.     PROCEDURE Start*;
  44.         VAR 
  45.             R: Texts.Reader; 
  46.             ch: CHAR; 
  47.             i, j, k, l: INTEGER;
  48.             err: LONGINT;
  49.             namePtr, namelen: LONGINT;
  50.     BEGIN
  51.         (********* Get Username/Password *********)
  52.         i := 0; j := 0;
  53.         Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos);
  54.         REPEAT Texts.Read(R, ch) UNTIL ch # " ";
  55.         IF (ch = 0DX) OR (ch = "%") OR (ch = "/") THEN Input.Read(ch);
  56.             WHILE (ch > " ")  & (ch # "%") & (ch # "/") & (ch # "@") DO
  57.                 IF i # 16 THEN user[i] := ch; INC(i) END; Input.Read(ch)
  58.             END;
  59.             IF (ch = "%") OR (ch = "/") THEN Input.Read(ch);
  60.                 WHILE ch >= " " DO
  61.                     IF j # 16 THEN passwd[j] := ch; INC(j); END; Input.Read(ch)
  62.                 END
  63.             END
  64.         ELSE
  65.             WHILE (ch > " ") & (ch # "%") & (ch # "/") DO
  66.                 IF i # 16 THEN user[i] := ch; INC(i) END; Texts.Read(R, ch)
  67.             END;
  68.             IF (ch = "%") OR (ch = "/") THEN Input.Read(ch);
  69.                 WHILE ch >= " " DO
  70.                     IF j # 16 THEN passwd[j] := ch; INC(j) END; Input.Read(ch)
  71.                 END
  72.             END
  73.         END;
  74.         user[i] := 0X; passwd[j] := 0X;
  75.         (********* Start NetSystemBase *********)
  76.         B.Start();
  77.         (******** Get HostName, convert it to hostIP ***********)
  78.         IF B.done THEN 
  79.             B.GetHostName(hostname);
  80.             IF B.done THEN 
  81.                 B.GetHostByName(hostname, hostIP);
  82.             END
  83.         END
  84.     END Start;
  85.     PROCEDURE Stop*;
  86.     BEGIN
  87.         B.Stop()
  88.     END Stop;
  89.     PROCEDURE GetIP* (name: ARRAY OF CHAR; VAR IP: IPAdr);
  90.         VAR done: BOOLEAN;
  91.     BEGIN
  92.         IF ('0' <= name[0]) & (name[0] <= '9') THEN B.GetHostByIP(name, IP)        (* dotted-decimal number *)
  93.         ELSIF ('A' <= CAP(name[0])) & (CAP(name[0]) <= 'Z') THEN B.GetHostByName(name, IP)    (* human name *)
  94.         ELSE IP:= anyIP
  95.         END;
  96.         IF ~B.done THEN IP:= anyIP END
  97.     END GetIP;
  98.     PROCEDURE GetName* (IP: IPAdr; VAR name: ARRAY OF CHAR);
  99.     BEGIN
  100.         B.GetHostByAdr(IP, name);
  101.         IF ~B.done THEN name[0]:= 0X END
  102.     END GetName;
  103. (************************************** TCP ****************************************)
  104.     PROCEDURE ReceiveBuffer(C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; pos: LONGINT; VAR len: LONGINT);
  105.         VAR length, help: LONGINT;
  106.     BEGIN
  107.         length:= 0;
  108.         LOOP
  109.             help:= len-length;
  110.             B.Recv(C.socket, buf, pos+length, help);
  111.             IF B.done THEN
  112.                 INC(length, help);
  113.                 IF length >= len THEN EXIT END
  114.             ELSE
  115.                 EXIT
  116.             END
  117.         END;
  118.         IF length >= len THEN C.res:=done ELSE C.res:= error END
  119.     END ReceiveBuffer;
  120.     PROCEDURE Available* (C: Connection): LONGINT;
  121.         VAR available, err, len: LONGINT;
  122.             ok: BOOLEAN;
  123.     BEGIN
  124.         available:= 0;
  125.         IF (C.state=inout) OR (C.state=in) THEN 
  126.             available:= B.Available(C.socket);
  127.             IF B.done & (available > 0)  THEN
  128.                 len:= Minimum(Minimum(buffersize - C.nofelems, buffersize - C.endidx), available);
  129.                 ReceiveBuffer(C, C.recvbuffer, C.endidx, len);
  130.                 IF C.res = done THEN
  131.                     INC(C.nofelems, len);
  132.                     C.endidx:= (C.endidx + len) MOD buffersize;
  133.                     available:= available - len
  134.                 END
  135.             ELSIF available = -1 THEN
  136.                 C.res:= error;
  137.                 available:= 0    (* reset available to have a correct return value *)
  138.             ELSE C.res:= done    (* available = 0 *)
  139.             END
  140.         END;
  141.         RETURN available + C.nofelems
  142.     END Available;
  143.     PROCEDURE Receive(C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER);
  144.         VAR err, available: LONGINT;
  145.     BEGIN
  146.         IF (C.state=inout) OR (C.state=in) THEN 
  147.             WHILE (C.nofelems > 0) & (len > 0) DO
  148.                 buf[beg]:= C.recvbuffer[C.begidx];
  149.                 INC(beg); C.begidx:= (C.begidx + 1) MOD buffersize;
  150.                 DEC(len); DEC(C.nofelems)
  151.             END;
  152.             WHILE len > 0 DO
  153.                 available:= B.Available(C.socket);
  154.                 IF B.done & (available > 0) THEN
  155.                     available:= Minimum(available, len);
  156.                     ReceiveBuffer(C, buf, beg, available);
  157.                     IF C.res= done THEN
  158.                         INC(beg, len); DEC(len, available)
  159.                     END
  160.                 ELSE C.res:= error; len := 0;
  161.                 END
  162.             END
  163.         ELSE C.res:= error    (* Reveive on a Connection with state=out OR state=listening *)
  164.         END;
  165.         res:= C.res
  166.     END Receive;
  167.     PROCEDURE Send(C: Connection; VAR buf: ARRAY OF SYSTEM.BYTE; beg, len: LONGINT; VAR res: INTEGER);
  168.         VAR help: LONGINT;
  169.     BEGIN
  170.         IF (C.state=inout) OR (C.state=out) THEN
  171.             WHILE len > 0 DO
  172.                 help:= len;
  173.                 B.Send(C.socket, buf, beg, help);
  174.                 IF B.done THEN
  175.                     res:= done;
  176.                     DEC(len, help);
  177.                     INC(beg, help)
  178.                 ELSE 
  179.                     res:= error;
  180.                     len:= 0
  181.                 END
  182.             END;
  183.         ELSE res:= error    (* Send on a Connection with state=in OR state=listening *)
  184.         END;
  185.         C.res:= res
  186.     END Send;
  187. PROCEDURE OpenConnection* (VAR C: Connection; locPort: INTEGER; remIP: IPAdr; remPort: INTEGER; 
  188.                                                     VAR res: INTEGER);
  189.         VAR socket, err: LONGINT;
  190.             myaddr, partneraddr : B.Sockaddrin;
  191.     BEGIN
  192.         IF remPort = anyport THEN remIP:= anyIP END;
  193.         B.Socket(socket, B.AFINET, B.SOCKSTREAM, B.IPPROTOTCP);
  194.         IF B.done THEN
  195.             IF remIP = anyIP THEN    (* TCP-Server *)
  196.                 myaddr.sinfamily:= B.AFINET;
  197.                 myaddr.sinaddr:= anyIP;
  198.                 myaddr.sinport:= B.IntToNet(locPort);
  199.                 B.Bind(socket, myaddr);
  200.                 IF B.done THEN
  201.                     B.Listen(socket);
  202.                     IF B.done THEN
  203.                         B.SetLinger(socket);
  204.                         NEW(C);
  205.                         C.socket:= socket;
  206.                         C.state:= listening;
  207.                         C.nofelems:= 0; C.begidx:= 0; C.endidx:= 0;
  208.                         C.res:= done;
  209.                         res:= done
  210.                     ELSE B.Close(socket); res:= error
  211.                     END
  212.                 ELSE B.Close(socket); res:= error
  213.                 END
  214.             ELSE    (* TCP-Client *)
  215.                 partneraddr.sinfamily:= B.AFINET;
  216.                 partneraddr.sinaddr:= remIP;
  217.                 partneraddr.sinport:= B.IntToNet(remPort);
  218.                 B.Connect(socket, partneraddr);
  219.                 IF B.done THEN
  220.                     B.SetLinger(socket);
  221.                     NEW(C);
  222.                     C.socket:= socket;
  223.                     C.state:= inout;
  224.                     C.nofelems:= 0; C.begidx:= 0; C.endidx:= 0;
  225.                     C.res:= done;
  226.                     res:= done
  227.                 ELSE
  228.                     B.Close(socket);
  229.                     res:= error
  230.                 END
  231.             END
  232.         END
  233.     END OpenConnection;
  234.     PROCEDURE CloseConnection* (C: Connection);
  235.         VAR err: LONGINT;
  236.     BEGIN
  237.         IF C # NIL THEN
  238.             B.Close(C.socket);
  239.             IF B.done THEN 
  240.                 C.res:= done;
  241.                 C.state:= closed
  242.             ELSE C.res:= error
  243.             END
  244.         END
  245.     END CloseConnection;
  246.     PROCEDURE Requested* (C: Connection): BOOLEAN;
  247.     BEGIN
  248.         RETURN (C.state = listening) & B.Requested(C.socket) & (B.done)
  249.     END Requested;
  250.     PROCEDURE Accept* (C: Connection; VAR newC: Connection; VAR res: INTEGER);
  251.         VAR newsocket: LONGINT;
  252.             ok: BOOLEAN;
  253.     BEGIN
  254.         IF C.state= listening THEN
  255.             B.Accept(C.socket, newsocket);
  256.             IF B.done THEN 
  257.                 NEW(newC);
  258.                 newC.socket:= newsocket;
  259.                 newC.state:= inout;    
  260.                 newC.res:= done;
  261.                 newC.nofelems:= 0; newC.begidx:= 0; newC.endidx:= 0;
  262.                 res:=done
  263.             ELSE res:= error
  264.             END
  265.         ELSE res:= error
  266.         END
  267.     END Accept;
  268.     PROCEDURE State* (C: Connection): INTEGER;
  269.     BEGIN
  270.         IF (~B.Connected(C.socket)) & (B.done) THEN C.state:= closed END;
  271.         RETURN C.state
  272.     END State;
  273.     PROCEDURE GetPartner* (C:Connection; VAR remIP: IPAdr; VAR remPort: INTEGER);
  274.         VAR addr: B.Sockaddrin;
  275.             len, err: LONGINT;
  276.     BEGIN
  277.         B.GetPeerName(C.socket, addr);
  278.         IF B.done THEN remIP:= addr.sinaddr; remPort:= addr.sinport
  279.         ELSE remIP:= anyIP; remPort:= anyport
  280.         END
  281.     END GetPartner;
  282.     (*----- Read -----*)
  283.     PROCEDURE Read* (C: Connection; VAR ch: CHAR);
  284.     BEGIN Receive(C, ch, 0, 1, C.res)
  285.     END Read;
  286.     PROCEDURE ReadBytes* (C: Connection; pos, len: LONGINT; VAR buf: B.Data);
  287.     BEGIN Receive(C, buf, pos, len, C.res);
  288.     END ReadBytes;
  289.     PROCEDURE ReadBool* (C: Connection; VAR b: BOOLEAN);
  290.     BEGIN Receive(C, b, 0, 1, C.res);
  291.     END ReadBool;
  292.     PROCEDURE ReadInt* (C: Connection; VAR x: INTEGER);
  293.     BEGIN Receive(C, x, 0, 2, C.res); x:= B.NetToInt(x)
  294.     END ReadInt;
  295.     PROCEDURE ReadLInt* (C: Connection; VAR x: LONGINT);
  296.     BEGIN Receive(C, x, 0, 4, C.res); x:= B.NetToLInt(x);
  297.     END ReadLInt;
  298.     PROCEDURE ReadString* (C: Connection; VAR s: ARRAY OF CHAR);
  299.         ch, ch0: CHAR;
  300.         i: INTEGER;
  301.     BEGIN i := -1; ch := 0X;
  302.         REPEAT INC(i);
  303.             ch0 := ch; Receive(C, ch, 0, 1, C.res); s[i] := ch;
  304.         UNTIL (C.res = error) OR (ch = 0X) OR (ch = 0AX);
  305.         IF (ch = 0AX) & (ch0 = 0DX) THEN s[i - 1] := 0X
  306.         ELSE s[i] := 0X
  307.         END
  308.     END ReadString;
  309.     (*----- Write -----*)
  310.     PROCEDURE Write* (C: Connection; ch: CHAR);
  311.     BEGIN Send(C, ch, 0, 1, C.res)
  312.     END Write;
  313.     PROCEDURE WriteBytes* (C: Connection; pos, len: LONGINT; VAR buf: B.Data);
  314.     BEGIN Send(C, buf, pos, len, C.res)
  315.     END WriteBytes;
  316.     PROCEDURE WriteBool* (C: Connection; b: BOOLEAN);
  317.     BEGIN Send(C, b, 0, 1, C.res)
  318.     END WriteBool;
  319.     PROCEDURE WriteInt* (C: Connection; x: INTEGER);
  320.     BEGIN x:= B.IntToNet(x); Send(C, x, 0, 2, C.res)
  321.     END WriteInt;
  322.     PROCEDURE WriteLInt* (C: Connection; x: LONGINT);
  323.     BEGIN x:= B.LIntToNet(x); Send(C, x, 0, 4, C.res)
  324.     END WriteLInt;
  325.     PROCEDURE WriteString* (C: Connection; s: ARRAY OF CHAR);
  326.         cs: ARRAY 2 OF CHAR;
  327.         i: INTEGER;
  328.     BEGIN  i := 0;
  329.         WHILE s[i] # 0X DO INC(i) END;
  330.         Send(C, s, 0, i, C.res);
  331.         cs[0] := 0DX; cs[1] := 0AX;
  332.         Send(C, cs, 0, 2, C.res)
  333.     END WriteString;
  334. (******************************** UDP **************************************)
  335.     PROCEDURE OpenSocket* (VAR S: Socket; locPort: INTEGER; VAR res: INTEGER);
  336.         VAR socket, err, port: LONGINT;
  337.             myaddr: B.Sockaddrin;
  338.     BEGIN
  339.         B.Socket(socket, B.AFINET, B.SOCKDGRAM, B.IPPROTOUDP);
  340.         IF B.done THEN
  341.             IF locPort # anyport THEN
  342.                 myaddr.sinfamily:= B.AFINET;
  343.                 myaddr.sinaddr:= anyIP;
  344.                 myaddr.sinport:= B.IntToNet(locPort);
  345.                 B.Bind(socket, myaddr);
  346.                 IF B.done THEN 
  347.                     NEW(S);
  348.                     S.socket:= socket;
  349.                     S.res:= done;
  350.                     res:= done;
  351.                 ELSE 
  352.                     B.Close(socket);
  353.                     res:= error
  354.                 END
  355.             END
  356.         END
  357.     END OpenSocket;
  358.     PROCEDURE CloseSocket* (S: Socket);
  359.         VAR err: LONGINT;
  360.     BEGIN
  361.         B.Close(S.socket);
  362.     END CloseSocket;
  363.     PROCEDURE AvailableDG* (S: Socket): LONGINT;
  364.         VAR err, result: LONGINT;
  365.     BEGIN
  366.         RETURN B.Available(S.socket)
  367.     END AvailableDG;
  368.     PROCEDURE SendDG* (S: Socket; remIP: IPAdr; remport: INTEGER; pos, len: LONGINT; VAR buf: B.Data);
  369.         VAR remaddr: B.Sockaddrin;
  370.             addr, res: LONGINT;
  371.             ok: BOOLEAN;
  372.     BEGIN
  373.         remaddr.sinfamily:= B.AFINET;
  374.         remaddr.sinport:= B.IntToNet(remport);
  375.         remaddr.sinaddr:= remIP;
  376.         B.SendTo(S.socket, remaddr, buf, pos, len);
  377.         IF B.done THEN S.res := done
  378.         ELSE S.res:= error
  379.         END
  380.     END SendDG;
  381.     PROCEDURE ReceiveDG* (S: Socket; VAR remIP: IPAdr; VAR remport: INTEGER; pos: LONGINT; VAR len: LONGINT; VAR buf: B.Data);
  382.         VAR remaddr: B.Sockaddrin;
  383.     BEGIN
  384.         B.RecvFrom(S.socket, remaddr, buf, pos, len);
  385.         IF B.done THEN 
  386.             remIP:= remaddr.sinaddr;
  387.             remport:= B.NetToInt(remaddr.sinport);
  388.             S.res:= done;
  389.         ELSE 
  390.             S.res:=error
  391.         END
  392.     END ReceiveDG;
  393.     PROCEDURE PutInt* (VAR buf: B.Data; pos, x: INTEGER);
  394.     BEGIN
  395.         ASSERT(pos <= LEN(buf) - SIZE(INTEGER));
  396.         x:= B.IntToNet(x);
  397.         SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(buf[pos]), SIZE(INTEGER))
  398.     END PutInt;
  399.     PROCEDURE PutLInt* (VAR buf: B.Data; pos: INTEGER; x: LONGINT);
  400.     BEGIN
  401.         ASSERT(pos <= LEN(buf) - SIZE(LONGINT));
  402.         x:= B.LIntToNet(x);
  403.         SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(buf[pos]), SIZE(LONGINT))
  404.     END PutLInt;
  405.     PROCEDURE GetInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: INTEGER);
  406.     BEGIN
  407.         ASSERT(pos <= LEN(buf) - SIZE(INTEGER));
  408.         SYSTEM.MOVE(SYSTEM.ADR(buf[pos]), SYSTEM.ADR(x), SIZE(INTEGER));
  409.         x:= B.NetToInt(x)
  410.     END GetInt;
  411.     PROCEDURE GetLInt* (VAR buf: ARRAY OF SYSTEM.BYTE; pos: INTEGER; VAR x: LONGINT);
  412.     BEGIN
  413.         ASSERT(pos <= LEN(buf) - SIZE(LONGINT));
  414.         SYSTEM.MOVE(SYSTEM.ADR(buf[pos]), SYSTEM.ADR(x), SIZE(LONGINT));
  415.         x:= B.NetToLInt(x)
  416.     END GetLInt;
  417. BEGIN 
  418.     anyIP[0] := CHR(0); anyIP[1] := CHR(0); anyIP[2] := CHR(0); anyIP[3] := CHR(0)
  419. END NetSystem.
  420.